home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / DDFOSSIL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-01  |  7KB  |  341 lines
  1.  
  2. unit ddfossil;
  3. {$S-,V-,R-}
  4.  
  5. interface
  6. uses dos;
  7.  
  8. type
  9.  ASCIZ_id = array[1..128] of char;
  10.  ascizptr  = ^asciz_id;
  11.  
  12.  fossildatatype = record
  13.                    strsize: word;
  14.                    majver: byte;
  15.                    minver: byte;
  16.                    ident: ascizPtr;
  17.                    ibufr: word;
  18.                    ifree: word;
  19.                    obufr: word;
  20.                    ofree: word;
  21.                    swidth: byte;
  22.                    sheight: byte;
  23.                    baud: byte;
  24.                   end;
  25. var
  26.  port_num: integer;
  27.  fossildata: fossildatatype;
  28.  
  29. procedure async_send(c: char);
  30. procedure async_send_string(s: string);
  31. function async_receive(var ch: char): boolean;
  32. function async_carrier_drop: boolean;
  33. function async_carrier_present : boolean;
  34. function async_buffer_check: boolean;
  35. function async_init_fossil: boolean;
  36. procedure async_deinit_fossil;
  37. procedure async_flush_output;
  38. procedure async_purge_output;
  39. procedure async_purge_input;
  40. procedure async_set_dtr(state: boolean);
  41. procedure async_watchdog_on;
  42. procedure async_watchdog_off;
  43. procedure async_warm_reboot;
  44. procedure async_cold_reboot;
  45. procedure async_set_baud(n: longint);
  46. procedure async_set_baudBnu(n: longint);
  47. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  48. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word;
  49.                               var fossilname:string);
  50.  
  51. implementation
  52.  
  53. procedure async_send(c: char);
  54. var
  55.  regs: registers;
  56. begin;
  57.  with regs do
  58.   begin
  59.     ah:=$01;
  60.     al:=byte(c);
  61.     dx:=port_num;
  62.   end;
  63.  intr($14,regs);
  64. end;
  65.  
  66. procedure async_send_string(s: string);
  67. var
  68.  a: integer;
  69. begin;
  70.  for a:=1 to length(s) do async_send(s[a]);
  71. end;
  72.  
  73. function async_receive(var ch: char): boolean;
  74. var
  75.  regs: registers;
  76. begin;
  77.  ch:=#0;
  78.  regs.ah:=$03;
  79.  regs.dx:=port_num;
  80.  intr($14,regs);
  81.  if (regs.ah and 1)=1 then begin;
  82.   regs.ah:=$02;
  83.   regs.dx:=port_num;
  84.   intr($14,regs);
  85.   ch:=chr(regs.al);
  86.   async_receive:=true;
  87.  end else async_receive:=false;
  88. end;
  89.  
  90. function async_carrier_drop: boolean;
  91. var
  92.  regs: registers;
  93. begin;
  94.  regs.ah:=$03;
  95.  regs.dx:=port_num;
  96.  intr($14,regs);
  97.  if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;
  98. end;
  99.  
  100. function async_carrier_present: boolean;
  101. var
  102.  regs: registers;
  103. begin;
  104.  regs.ah:=$03;
  105.  regs.dx:=port_num;
  106.  intr($14,regs);
  107.  if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;
  108. end;
  109.  
  110. function async_buffer_check: boolean;
  111. var
  112.  regs: registers;
  113. begin;
  114.  regs.ah:=$03;
  115.  regs.dx:=port_num;
  116.  intr($14,regs);
  117.  if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;
  118. end;
  119.  
  120. function async_init_fossil: boolean;
  121. var
  122.  regs: registers;
  123. begin;
  124.  regs.ah:=$04;
  125.  regs.bx:=$00;
  126.  regs.dx:=port_num;
  127.  intr($14,regs);
  128.  if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;
  129. end;
  130.  
  131. procedure async_deinit_fossil;
  132. var
  133.  regs: registers;
  134. begin;
  135.  regs.ah:=$05;
  136.  regs.dx:=port_num;
  137.  intr($14,regs);
  138. end;
  139.  
  140. procedure async_set_dtr(state: boolean);
  141. var
  142.  regs: registers;
  143. begin;
  144.  regs.ah:=$06;
  145.  if state then regs.al:=1 else regs.al:=0;
  146.  regs.dx:=port_num;
  147.  intr($14,regs);
  148. end;
  149.  
  150. procedure async_flush_output;
  151. var
  152.  regs: registers;
  153. begin;
  154.  regs.ah:=$08;
  155.  regs.dx:=port_num;
  156.  intr($14,regs);
  157. end;
  158.  
  159. procedure async_purge_output;
  160. var
  161.  regs: registers;
  162. begin;
  163.  regs.ah:=$09;
  164.  regs.dx:=port_num;
  165.  intr($14,regs);
  166. end;
  167.  
  168. procedure async_purge_input;
  169. var
  170.  regs: registers;
  171. begin;
  172.  regs.ah:=$0A;
  173.  regs.dx:=port_num;
  174.  intr($14,regs);
  175. end;
  176.  
  177. procedure async_watchdog_on;
  178. var
  179.  regs: registers;
  180. begin;
  181.  regs.ah:=$14;
  182.  regs.al:=$01;
  183.  regs.dx:=port_num;
  184.  intr($14,regs);
  185. end;
  186.  
  187. procedure async_watchdog_off;
  188. var
  189.  regs: registers;
  190. begin;
  191.  regs.ah:=$14;
  192.  regs.al:=$00;
  193.  regs.dx:=port_num;
  194.  intr($14,regs);
  195. end;
  196.  
  197. procedure async_warm_reboot;
  198. var
  199.  regs: registers;
  200. begin;
  201.  regs.ah:=$17;
  202.  regs.al:=$01;
  203.  intr($14,regs);
  204. end;
  205.  
  206. procedure async_cold_reboot;
  207. var
  208.  regs: registers;
  209. begin;
  210.  regs.ah:=$17;
  211.  regs.al:=$00;
  212.  intr($14,regs);
  213. end;
  214.  
  215. procedure async_set_baud(n: longint);
  216. var
  217.  w : word;
  218.  regs: registers;
  219. begin;
  220.  regs.ah:=$00;
  221.  regs.al:=$03;
  222.  regs.dx:=port_num;
  223.  w := n;
  224.  
  225.  If n > 76800 then         {115200 }
  226.    regs.al:=regs.al or $80
  227.  else
  228.  If n > 57600 then         { 76800 }
  229.    regs.al:=regs.al or $60
  230.  else
  231.    case w of
  232.      300  : regs.al:=regs.al or $40;
  233.      600  : regs.al:=regs.al or $60;
  234.      1200 : regs.al:=regs.al or $80;
  235.      2400 : regs.al:=regs.al or $A0;
  236.      4800 : regs.al:=regs.al or $C0;
  237.      9600 : regs.al:=regs.al or $E0;
  238.      9601..19200:  regs.al:=regs.al or $00;
  239.      19201..38400: regs.al:=regs.al or $20;
  240.      38401..57600: regs.al:=regs.al or $40;
  241.    end;
  242.  
  243.  intr($14,regs);
  244. end;
  245.  
  246. procedure async_set_baudBnu(n: longint);
  247. var
  248.  w : word;
  249.  regs: registers;
  250. begin;
  251.  regs.ah:=$00;
  252.  regs.al:=$03;
  253.  regs.dx:=port_num;
  254.  w := n;
  255.  
  256.  If n>38400 then
  257.   begin
  258.     If n > 57600 then               {115200}
  259.       regs.al:=regs.al or $80
  260.     else
  261.       regs.al:=regs.al or $60;       { 57600 }
  262.     regs.bx:=$69DC;
  263.     regs.cx:=$69DC;
  264.   end
  265.  else
  266.    case w of
  267.      300  : regs.al:=regs.al or $40;
  268.      600  : regs.al:=regs.al or $60;
  269.      1200 : regs.al:=regs.al or $80;
  270.      2400 : regs.al:=regs.al or $A0;
  271.      4800 : regs.al:=regs.al or $C0;
  272.      9600 : regs.al:=regs.al or $E0;
  273.      9601..19200:  regs.al:=regs.al or $00;
  274.      19201..38400: regs.al:=regs.al or $20;
  275.    end;
  276.  
  277.  intr($14,regs);
  278. end;
  279. {
  280. The "enhanced" port rate settings are accessed by setting the both BX
  281. and CX CPU registeres to the magic value 0x69dc when calling Fn 0 (INT
  282. 14H, AH=0). This changes the meaning of the meaning of the three bits
  283. used to set the baud rate, bits 5-7, according to this table:
  284.  
  285.     Value       Standard        Enhanced (BX=CX=69DCh)
  286.     -----       --------        --------
  287.     000           19200              75
  288.     001           38400             110
  289.     010             300            7200
  290.     011             600           57600
  291.     100            1200          115200
  292.     101            2400          |
  293.     110            4800          | undefined
  294.     111            9600          |
  295.  
  296. david  }
  297.  
  298. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  299. var
  300.  regs: registers;
  301. begin;
  302.  regs.ah:=$0F;
  303.  regs.al:=$00;
  304.  if softtran then regs.al:=regs.al or $01;
  305.  if Hard then regs.al:=regs.al or $02;
  306.  if SoftRecv then regs.al:=regs.al or $08;
  307.  regs.al:=regs.al or $F0;
  308.  Intr($14,regs);
  309. end;
  310.  
  311. procedure async_get_fossil_data;
  312. var
  313.  regs: registers;
  314. begin;
  315.  regs.ah:=$1B;
  316.  regs.cx:=sizeof(fossildata);
  317.  regs.dx:=port_num;
  318.  regs.es:=seg(fossildata);
  319.  regs.di:=ofs(fossildata);
  320.  intr($14,regs);
  321. end;
  322.  
  323. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word;
  324.                               var fossilname:string);
  325. var
  326.  i:byte;
  327. begin;
  328.  async_get_fossil_data;
  329.  insize:=fossildata.ibufr;
  330.  infree:=fossildata.ifree;
  331.  outsize:=fossildata.obufr;
  332.  outfree:=fossildata.ofree;
  333.  i := 1;
  334.  while (i<62) and (fossildata.ident^[i] <> #0)  do
  335.    inc(i);
  336.  move(fossildata.ident^, fossilname[1], i);
  337.  fossilname[0] := char(i);
  338. end;
  339.  
  340. end.
  341.